home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / TextPrinter.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-29  |  22.2 KB  |  527 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. MODULE TextPrinter;    (** CAS/MH/HM 23.9.1993 **)
  5.     IMPORT
  6.         Files, Display, Fonts, Printer, Texts, TextFrames, Macintosh, Sys, SYSTEM;
  7.     CONST
  8.         Unit* = 3048;    (**unit for a 300 dpi printer**)
  9.         unit = TextFrames.Unit;
  10.         mm = TextFrames.mm; Scale = mm DIV 10;
  11.         gridAdj = TextFrames.gridAdj;
  12.         leftAdj = TextFrames.leftAdj; rightAdj = TextFrames.rightAdj; AdjMask = {leftAdj, rightAdj};
  13.         pageBreak = TextFrames.pageBreak;
  14.         twoColumns = TextFrames.twoColumns;
  15.         AdjustSpan = 30; MinTabWidth = 1 * Scale; StdTabWidth = 4 * mm;
  16.         ColumnGap = 7*mm;
  17.         TAB = 9X; CR = 0DX;
  18.         MaxDict = 32;    MaxLine = 512;
  19.     TYPE
  20.         PrintMsg* = RECORD (Texts.ElemMsg)
  21.             prepare*: BOOLEAN;
  22.             indent*: LONGINT;    (**prepare => width already consumed in line, in units**)
  23.             fnt*: Fonts.Font;
  24.             col*: SHORTINT;
  25.             pos*: LONGINT;    (**position in host text**)
  26.             X0*, Y0*, pno*: INTEGER    (**receiver origin in screen space; page number**)
  27.         END;
  28.         PrintLine = RECORD
  29.             eot: BOOLEAN;    (*marked to skip, contains end of text*)
  30.             indent: LONGINT;
  31.             w, h, dsr: INTEGER;    (*bounding box clipped to frame*)
  32.             nob: INTEGER;    (*number of contained blanks; > 0 if text line wraps around*)
  33.             org, len, span: LONGINT;    (*len w/o; span w/ trailing CR or white space, if any*)
  34.             pbeg: LONGINT    (*position of corresponding parc*)
  35.         END;
  36.         P: TextFrames.Parc;
  37.         pbeg: LONGINT;
  38.         R: Texts.Reader;
  39.         nextCh: CHAR;
  40.         fname: ARRAY 32 OF CHAR;
  41.         fonts: RECORD
  42.             num: SHORTINT;
  43.             dict: ARRAY MaxDict OF Fonts.Font;
  44.             dx: ARRAY MaxDict, 256 OF SHORTINT
  45.         END;
  46.         line: RECORD
  47.             first: BOOLEAN;
  48.             fno: SHORTINT;
  49.             col: SHORTINT;
  50.             px, x, y: INTEGER;
  51.             len: INTEGER;
  52.             buf: ARRAY MaxLine OF CHAR
  53.         END;
  54.     TextWidth: PROCEDURE (textbuf: LONGINT; firstByte, byteCount: INTEGER) : INTEGER;
  55.     PROCEDURE Min (x, y: LONGINT): LONGINT;
  56.     BEGIN
  57.         IF x < y THEN RETURN x ELSE RETURN y END
  58.     END Min;
  59.     PROCEDURE Max (x, y: INTEGER): INTEGER;
  60.     BEGIN
  61.         IF x > y THEN RETURN x ELSE RETURN y END
  62.     END Max;
  63.     PROCEDURE Append (VAR s1: ARRAY OF CHAR; i: INTEGER; s2: ARRAY OF CHAR);
  64.         VAR j: INTEGER;
  65.     BEGIN j := 0;    (*s1 large enough*)
  66.         WHILE s2[j] # 0X DO s1[i] := s2[j]; INC(i); INC(j) END;
  67.         s1[i] := 0X
  68.     END Append;
  69.     (** Printer Metrics **)
  70.     PROCEDURE SetMetrics (fno: SHORTINT; fnt: Fonts.Font);
  71.         VAR f: Files.File; r: Files.Rider; pat: Display.Pattern;
  72.             off, i, j, k, dx, x, y, w, h: INTEGER; size, s: SHORTINT; mod, m: CHAR;
  73.             name: ARRAY 32 OF CHAR; found: BOOLEAN;
  74.     BEGIN COPY(fnt.name, name);
  75.         i := 0; WHILE name[i] > "9" DO INC(i) END;
  76.         j := i; WHILE ("0" <= name[j]) & (name[j] < "9") DO INC(j) END;
  77.         k := j; WHILE (name[k] # ".") & (name[k] # 0X) DO INC(k) END;
  78.         IF k > j THEN mod := name[k-1] ELSE mod := " " END;
  79.         size := 0; k := i; WHILE i < j DO size := 10 * size + SHORT(ORD(name[i]) - 30H); INC(i) END;
  80.         Append(name, k, ".Lm3.Fnt"); f := Files.Old(name);
  81.         IF f # NIL THEN Files.Set(r, f, 2); Files.ReadInt(r, off); Files.Set(r, f, 6); i := -1;
  82.             REPEAT INC(i); Files.Read(r, s); Files.Read(r, m) UNTIL (s = size) & (m = mod) OR (Files.Pos(r) >= off);
  83.             IF (s = size) & (m = mod) THEN Files.Set(r, f, off + i * 260 + 4); Files.ReadBytes(r, fonts.dx[fno], 256)
  84.             ELSE f := NIL
  85.             END
  86.         END;
  87.         IF f = NIL THEN i := 0;    (*no printer metrics file found - construct from screen metrics*)
  88.             Macintosh.prGetMetrics (fnt.name, fonts.dx[fno], found);
  89.             IF ~found THEN
  90.                 WHILE i < 256 DO Display.GetChar(fnt.raster, CHR(i), dx, x, y, w, h, pat);
  91.                     fonts.dx[fno, i] := SHORT(SHORT(LONG(dx) * unit * 12 DIV 10 DIV Unit)); INC(i)
  92.                     (*+20% : heuristical correction*)
  93.                 END
  94.             END
  95.         END
  96.     END SetMetrics;
  97.     PROCEDURE FontNo* (fnt: Fonts.Font): SHORTINT;
  98.         VAR fno: SHORTINT;
  99.     BEGIN fno := 0; fonts.dict[fonts.num] := fnt;
  100.         WHILE fonts.dict[fno] # fnt DO INC(fno) END;
  101.         IF fno = fonts.num THEN SetMetrics(fno, fnt); INC(fonts.num) END;
  102.         RETURN fno
  103.     END FontNo;
  104.     PROCEDURE Font* (fno: SHORTINT): Fonts.Font;
  105.     BEGIN RETURN fonts.dict[fno]
  106.     END Font;
  107.     PROCEDURE DX* (fno: SHORTINT; ch: CHAR): LONGINT;
  108.     BEGIN RETURN LONG(LONG(fonts.dx[fno, ORD(ch)])) * Unit
  109.     END DX;
  110.     PROCEDURE Get* (fno: SHORTINT; ch: CHAR; VAR dx, x, y, w, h: LONGINT);
  111.         VAR pat: Display.Pattern; dx0, x0, y0, w0, h0: INTEGER;
  112.     BEGIN Display.GetChar(fonts.dict[fno].raster, ch, dx0, x0, y0, w0, h0, pat);
  113.         x := LONG(x0) * unit; y := LONG(y0) * unit; h := LONG(h0) * unit;
  114.         dx := LONG(LONG(fonts.dx[fno, ORD(ch)])) * Unit; w := dx
  115.     END Get;
  116.     PROCEDURE GetChar* (fno: SHORTINT; targetUnit: LONGINT; ch: CHAR;
  117.                 VAR pdx: LONGINT; VAR dx, x, y, w, h: INTEGER; VAR pat: Display.Pattern);
  118.     BEGIN Display.GetChar(fonts.dict[fno].raster, ch, dx, x, y, w, h, pat);
  119.         x := SHORT(x * LONG(unit) DIV targetUnit); y := SHORT(y * LONG(unit) DIV targetUnit);
  120.         h := SHORT(h * LONG(unit) DIV targetUnit);
  121.         pdx := LONG(LONG(fonts.dx[fno, ORD(ch)])) * Unit;
  122.         dx := SHORT(pdx DIV targetUnit); w := dx
  123.     END GetChar;
  124.     PROCEDURE InitFonts*;
  125.         VAR fno: SHORTINT;
  126.     BEGIN (* fonts.num := 0; fno := FontNo(Fonts.Default) *)
  127.     END InitFonts;
  128.     PROCEDURE Width (fno: SHORTINT; VAR s: ARRAY OF CHAR): INTEGER;
  129.         VAR i, w: INTEGER;
  130.     BEGIN i := 0; w := 0;
  131.         WHILE s[i] # 0X DO INC(w, LONG(fonts.dx[fno, ORD(s[i])]) ); INC(i) END;
  132.         RETURN w
  133.     END Width;
  134.     PROCEDURE GetPrintChar (fnt: Fonts.Font; ch: CHAR; VAR fno: SHORTINT; VAR dx, x, y, w, h: INTEGER);
  135.         VAR pat: Display.Pattern;
  136.     BEGIN Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
  137.         x := SHORT(x * LONG(unit) DIV Unit); y := -SHORT((-y) * LONG(unit) DIV Unit);
  138.         h := SHORT(h * LONG(unit) DIV Unit);
  139.         fno := FontNo(fnt); dx := fonts.dx[fno, ORD(ch)]; w := dx
  140.     END GetPrintChar;
  141.     PROCEDURE Tab (dw: INTEGER; VAR dx: INTEGER);    (*P set*)
  142.         VAR i, n: INTEGER; w: LONGINT;
  143.     BEGIN i := 0; n := P.nofTabs; w := LONG(dw) * Unit + MinTabWidth;
  144.         IF dw < 0 THEN dx := -dw
  145.         ELSE
  146.             WHILE (i < n) & (P.tab[i] < w) DO INC(i) END;
  147.             IF i < n THEN dx := SHORT((P.tab[i] - LONG(dw) * Unit) DIV Unit)
  148.             ELSE dx := StdTabWidth DIV Unit
  149.             END
  150.         END
  151.     END Tab;
  152.     PROCEDURE Offset (): INTEGER;    (*R set*)
  153.     BEGIN
  154.         IF R.voff = 0 THEN RETURN 0
  155.         ELSE RETURN SHORT(R.fnt.height * R.voff * LONG(unit) DIV 64 DIV Unit)
  156.         END
  157.     END Offset;
  158.     PROCEDURE MeasureSpecial (pno, dw: INTEGER; VAR fno: SHORTINT; VAR dx, x, y, w, h: INTEGER);
  159.         (*P, R, nextCh set*)
  160.         VAR e: Texts.Elem; i: INTEGER; msg: PrintMsg;
  161.     BEGIN
  162.         IF nextCh = " " THEN GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h);
  163.             x := 0; y := 0; w := dx; h := 0
  164.         ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0
  165.         ELSIF R.elem # NIL THEN e := R.elem;
  166.             msg.prepare := TRUE; msg.indent := LONG(dw) * Unit;
  167.             msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R) - 1; msg.pno := pno;
  168.             msg.Y0 := -SHORT(P.dsr DIV Unit);
  169.             e.handle(e, msg);
  170.             w := SHORT(e.W DIV Unit); dx := w; h := SHORT(e.H DIV Unit);
  171.             x := 0; y := msg.Y0
  172.         ELSE GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h)
  173.         END
  174.     END MeasureSpecial;
  175.     PROCEDURE GetSpecial (VAR n: INTEGER; maxW, cn, ddx, dw: INTEGER;
  176.             VAR fno: SHORTINT; VAR dx, x, y, w, h: INTEGER);    (*P, R, nextCh set*)
  177.         VAR e: Texts.Elem;
  178.     BEGIN
  179.         IF nextCh = " " THEN GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h);
  180.             x := 0; y := 0; INC(dx, ddx); INC(n); IF n <= cn THEN INC(dx) END;    (*space correction for block adjustment*)
  181.             w := dx; h := 0
  182.         ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0
  183.         ELSIF R.elem # NIL THEN e := R.elem;
  184.                 IF e IS TextFrames.Parc THEN w := SHORT(Min(P.width DIV Unit, maxW)); e.W := LONG(w) * Unit
  185.                 ELSE w := SHORT(e.W DIV Unit)
  186.                 END;
  187.                 dx := w; x := 0; y := -SHORT(P.dsr DIV Unit); h := SHORT(e.H DIV Unit)
  188.         ELSE GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h)
  189.         END
  190.     END GetSpecial;
  191.     PROCEDURE AdjustMetrics (T: Texts.Text; VAR t: PrintLine; left: INTEGER; VAR pw, tw, ddx, cn: INTEGER);
  192.         (*sets P, pbeg*)
  193.     BEGIN pw := left; tw := t.w; ddx := 0; cn := 0;
  194.         TextFrames.ParcBefore(T, t.org, P, pbeg);
  195.         IF pbeg # t.org THEN
  196.             INC(pw, SHORT((P.left + t.indent) DIV Unit));
  197.             DEC(tw, SHORT(t.indent DIV Unit));
  198.             IF leftAdj IN P.opts THEN
  199.                 IF (rightAdj IN P.opts) & (t.nob > 0) THEN
  200.                     tw := SHORT((P.width - t.indent) DIV Unit); ddx := (tw - t.w) DIV t.nob; cn := (tw - t.w) MOD t.nob
  201.                 END
  202.             ELSIF rightAdj IN P.opts THEN INC(pw, SHORT(P.width DIV Unit) - t.w)
  203.             ELSE (*center*) INC(pw, (SHORT(P.width DIV Unit) - t.w) DIV 2)
  204.             END
  205.         END
  206.     END AdjustMetrics;
  207.     (* Printer Line Casting *)
  208.     PROCEDURE MeasureLine (T: Texts.Text; pno, maxW: INTEGER; VAR t: PrintLine);    (*R, nextCh set*)
  209.         VAR len, bklen, d: LONGINT; eol: BOOLEAN; fno: SHORTINT;
  210.             nob, bknob, width, minY, bkminY, maxY, bkmaxY, tw, bktw, lsp, dsr, dx, x, y, w, h: INTEGER;
  211.             R1: Texts.Reader; peekCh: CHAR;
  212.     BEGIN len := 0; nob := 0; bklen := -999; tw := 0; dx := 0; minY := 0; maxY := 0;
  213.         TextFrames.ParcBefore(T, t.org, P, pbeg);
  214.         lsp := SHORT(P.lsp DIV Unit); dsr := SHORT(P.dsr DIV Unit); width := SHORT(P.width DIV Unit);
  215.         t.indent := 0;
  216.         IF t.org > 0 THEN Texts.OpenReader(R1, T, t.org - 1); Texts.Read(R1, peekCh);
  217.             IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS TextFrames.Parc) THEN t.indent := P.first END;
  218.         END;
  219.         DEC(width, SHORT(t.indent DIV Unit));
  220.         LOOP INC(tw, dx);
  221.             IF R.eot OR (nextCh = CR) THEN nob := 0; eol := ~R.eot; EXIT END;
  222.             IF nextCh <= " " THEN MeasureSpecial(pno, tw + SHORT(t.indent DIV Unit), fno, dx, x, y, w, h)
  223.             ELSE GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h)
  224.             END;
  225.             IF tw + dx > width THEN d := len - bklen;
  226.                 IF (0 <= d) & (d < AdjustSpan) & (nextCh > " ") THEN eol := TRUE;
  227.                     Texts.OpenReader(R, T, Texts.Pos(R) - d);
  228.                     nob := bknob; len := bklen; tw := bktw; minY := bkminY; maxY := bkmaxY
  229.                 ELSIF len = 0 THEN    (*force at least one character on each line*)
  230.                     INC(len); INC(y, Offset()); minY := SHORT(Min(minY, y)); maxY := Max(maxY, y + h);
  231.                     Texts.Read(R, nextCh); eol := FALSE
  232.                 ELSE eol := (nextCh <= " ") & (nextCh # Texts.ElemChar)
  233.                 END;
  234.                 EXIT
  235.             END;
  236.             IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN
  237.                 bknob := nob; bklen := len; bktw := tw; bkminY := minY; bkmaxY := maxY;
  238.                 IF nextCh = " " THEN INC(nob) END
  239.             END;
  240.             INC(len); INC(y, Offset()); minY := SHORT(Min(minY, y)); maxY := Max(maxY, y + h);
  241.             Texts.Read(R, nextCh)
  242.         END;
  243.         IF gridAdj IN P.opts THEN
  244.             WHILE dsr < -minY DO INC(dsr, lsp) END;
  245.             t.h := Max(lsp, dsr + maxY); INC(t.h, (-t.h) MOD lsp)
  246.         ELSE dsr := Max(dsr, -minY); t.h := Max(lsp, dsr + maxY)
  247.         END;
  248.         t.len := len; t.w := SHORT(Min(tw, maxW)); t.dsr := dsr; t.nob := nob; t.eot := R.eot; t.pbeg := pbeg;
  249.         IF eol THEN Texts.Read(R, nextCh); t.span := len + 1 ELSE t.span := len END
  250.     END MeasureLine;
  251.     (** Printer Page Placement **)
  252.     PROCEDURE FlushLine;
  253.     VAR red, green, blue: INTEGER;
  254.     BEGIN
  255.         IF line.len > 0 THEN line.buf[line.len] := 0X; line.len := 0;
  256.             Display.GetColor (line.col, red, green, blue);
  257.             Printer.UseColor (red, green, blue);
  258.             IF line.first THEN Printer.String(line.px, line.y, line.buf, fonts.dict[line.fno].name); line.first := FALSE
  259.             ELSE Printer.ContString(line.buf, fonts.dict[line.fno].name)
  260.             END
  261.         END
  262.     END FlushLine;
  263.     PROCEDURE LengthMismatch (ch: CHAR; fno: SHORTINT) : BOOLEAN;
  264.     VAR len1, len2, i: INTEGER;
  265.     BEGIN
  266.         line.buf[line.len] := ch;
  267.         len1 := 0;
  268.         FOR i := 0 TO line.len DO len1 := len1 + fonts.dx[fno, ORD(line.buf[i])] END;
  269.         len2 := TextWidth (SYSTEM.ADR (line.buf[0]), 0, line.len + 1); 
  270.         RETURN len1 # len2
  271.     END LengthMismatch;
  272.     PROCEDURE PlaceChar (ch: CHAR; fno, col: SHORTINT; x, y, dx: INTEGER);
  273.     BEGIN
  274.         IF line.len > 0 THEN
  275.             IF (x # line.x) OR (y # line.y) OR LengthMismatch (ch, fno) THEN FlushLine; line.first := TRUE; line.px := x
  276.             ELSIF fno # line.fno THEN FlushLine
  277.             ELSIF col # line.col THEN FlushLine
  278.             END
  279.         ELSE line.px := x
  280.         END;
  281.         line.fno := fno; line.col := col; line.x := x + dx; line.y := y; line.buf[line.len] := ch; INC(line.len)
  282.     END PlaceChar;
  283.     PROCEDURE PlaceChar (ch: CHAR; fno: SHORTINT; x, y, dx: INTEGER);
  284.     BEGIN
  285.         IF line.len > 0 THEN
  286.             FlushLine; line.first := TRUE; line.px := x
  287.         ELSE line.px := x
  288.         END;
  289.         line.fno := fno; line.x := x + dx; line.y := y; line.buf[line.len] := ch; INC(line.len)
  290.     END PlaceChar;
  291.     PROCEDURE PlaceSpecial (fno: SHORTINT; pno, nob, px, py, x, y, dx: INTEGER);    (*R, nextCh set*)
  292.         VAR e: Texts.Elem; msg: PrintMsg;
  293.     BEGIN
  294.         IF (nextCh = " ") & (P.opts * AdjMask = AdjMask) & (nob > 0) OR (nextCh = TAB) THEN (*skip*)
  295.         ELSIF R.elem # NIL THEN e := R.elem;
  296.             FlushLine; line.first := TRUE;
  297.             msg.prepare := FALSE;
  298.             msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R) - 1;
  299.             msg.X0 := px + x; msg.Y0 := py + y; msg.pno := pno;
  300.             e.handle(e, msg)
  301.         ELSE PlaceChar(nextCh, fno, R.col, px, py, dx)
  302.         END
  303.     END PlaceSpecial;
  304.     PROCEDURE PlaceLine (T: Texts.Text; pno: INTEGER; VAR t: PrintLine; left, width, py: INTEGER);
  305.         VAR i: LONGINT; n, cn, lm, rm, px, pw, tw, ddx, dx, x, y, w, h: INTEGER; fno: SHORTINT;
  306.     BEGIN Texts.OpenReader(R, T, t.org); AdjustMetrics(T, t, left, pw, tw, ddx, cn);
  307.         lm := left + SHORT(P.left DIV Unit); rm := left + width; px := pw; INC(py, t.dsr); i := 0; n := 0;
  308.         line.first := TRUE; line.len := 0;
  309.         WHILE i < t.len DO Texts.Read(R, nextCh);
  310.             IF nextCh <= " " THEN GetSpecial(n, width, cn, ddx, px - lm, fno, dx, x, y, w, h)
  311.             ELSE GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h)
  312.             END;
  313.             IF px + dx (* x + w *) <= rm THEN
  314.                 IF nextCh <= " " THEN PlaceSpecial(fno, pno, t.nob, px, py, x, y + Offset(), dx)
  315.                 ELSE PlaceChar(nextCh, fno, R.col, px, py + Offset(), dx)
  316.                 END;
  317.                 INC(px, dx); INC(i)
  318.             ELSE i := t.len
  319.             END
  320.         END;
  321.         FlushLine
  322.     END PlaceLine;
  323.     PROCEDURE PlaceHeader* (headerX, headerY, headerW: INTEGER;
  324.             pno: INTEGER; fnt: Fonts.Font; VAR header: ARRAY OF CHAR; alt: BOOLEAN);
  325.         VAR i, j: INTEGER; fno: SHORTINT; digits, pageno: ARRAY 16 OF CHAR;
  326.     BEGIN alt := alt & ~ODD(pno); fno := FontNo(fnt);
  327.         IF (pno >= 0) OR (pno < -30) THEN pno := ABS(pno); i := 0; j := 0;
  328.             REPEAT digits[i] := CHR(pno MOD 10 + 30H); INC(i); pno := pno DIV 10 UNTIL pno = 0;
  329.             REPEAT DEC(i); pageno[j] := digits[i]; INC(j) UNTIL i = 0;
  330.             pageno[j] := 0X
  331.         ELSE pno := ABS(pno); i := 0;
  332.             WHILE pno >= 10 DO DEC(pno, 10); pageno[i] := "x"; INC(i) END;
  333.             CASE pno OF
  334.                 0:
  335.             |   1..3: WHILE pno > 0 DO DEC(pno); pageno[i] := "i"; INC(i) END
  336.             |   4: pageno[i] := "i"; INC(i); pageno[i] := "v"; INC(i)
  337.             |   5..8: DEC(pno, 5); pageno[i] := "v"; INC(i);
  338.                     WHILE pno > 0 DO DEC(pno); pageno[i] := "i"; INC(i) END
  339.             |   9: pageno[i] := "i"; INC(i); pageno[i] := "x"; INC(i)
  340.             END;
  341.             pageno[i] := 0X
  342.         END;
  343.         IF alt THEN Printer.String(headerX, headerY, pageno, fonts.dict[fno].name);
  344.             IF header[0] # 0X THEN
  345.                 Printer.String(headerX + headerW - Width(fno, header), headerY, header, fonts.dict[fno].name)
  346.             END
  347.         ELSE Printer.String(headerX + headerW - Width(fno, pageno), headerY, pageno, fonts.dict[fno].name);
  348.             IF header[0] # 0X THEN Printer.String(headerX, headerY, header, fonts.dict[fno].name) END
  349.         END
  350.     END PlaceHeader;
  351.     PROCEDURE ClaimPrinter;    (*send null-command to keep printer connection alive*)
  352.         VAR i: INTEGER; dmy: ARRAY 32 OF CHAR;
  353.     BEGIN dmy[0] := 0X; i := 10;
  354.         WHILE i > 0 DO Printer.String(0, 0, dmy, fname); DEC(i) END
  355.     END ClaimPrinter;
  356.     (*PROCEDURE PrintDraft* (t: Texts.Text; header: ARRAY OF CHAR; copies: INTEGER);
  357.         CONST left = 160; bot = 100; lsp = 32;
  358.         VAR top, y, pno, i: INTEGER; r: Texts.Reader; ch: CHAR; s: ARRAY 256 OF CHAR;
  359.         PROCEDURE PrintHeader;
  360.         BEGIN
  361.             Printer.String(left, Printer.PageHeight - 125, header, Fonts.Default.name);
  362.             IF pno < 10 THEN s[0] := " " ELSE s[0] := CHR(30H + pno MOD 100 DIV 10) END;
  363.             s[1] := CHR(30H + pno MOD 10); s[2] := 0X;
  364.             Printer.String(Printer.PageWidth - 236, Printer.PageHeight - 125, s, Fonts.Default.name)
  365.         END PrintHeader;
  366.     BEGIN
  367.         pno := 0; top := Printer.PageHeight - 225; y := top;
  368.         Printer.UseListFont(Fonts.Default.name);
  369.         PrintHeader;
  370.         Texts.OpenReader(r, t, 0);
  371.         REPEAT Texts.Read(r, ch);
  372.             i := 0; WHILE ~r.eot & (ch # CR) DO s[i] := ch; INC(i); Texts.Read(r, ch) END;
  373.             s[i] := 0X;
  374.             Printer.String(left, y, s, Fonts.Default.name);
  375.             y := y - lsp;
  376.             IF y < bot THEN Printer.Page(copies); INC(pno); PrintHeader; y := top END
  377.         UNTIL r.eot;
  378.         IF y < top THEN Printer.Page(copies) END
  379.     END PrintDraft;*)
  380.     PROCEDURE PrintDraft* (t: Texts.Text; header: ARRAY OF CHAR; copies: INTEGER);
  381.         CONST left = 160; bot = 100; lsp = 32; maxLineLen = 120;
  382.         VAR top, y, pno, i, b: INTEGER; org: LONGINT; r: Texts.Reader; ch: CHAR; s: ARRAY maxLineLen + 1 OF CHAR;
  383.         PROCEDURE PrintHeader;
  384.         BEGIN
  385.             Printer.String(left, Printer.PageHeight - 125, header, Fonts.Default.name);
  386.             IF pno < 10 THEN s[0] := " " ELSE s[0] := CHR(30H + pno MOD 100 DIV 10) END;
  387.             s[1] := CHR(30H + pno MOD 10); s[2] := 0X;
  388.             Printer.String(Printer.PageWidth - 236, Printer.PageHeight - 125, s, Fonts.Default.name)
  389.         END PrintHeader;
  390.     BEGIN
  391.         pno := 0; top := Printer.PageHeight - 225; y := top;
  392.         Printer.UseListFont(Fonts.Default.name);
  393.         PrintHeader;
  394.         Texts.OpenReader(r, t, 0);
  395.         REPEAT
  396.             org := Texts.Pos(r); Texts.Read(r, ch); i := 0; b := 0;
  397.             WHILE ~r.eot & (ch # CR) & (i < maxLineLen) DO
  398.                 IF ch = " " THEN b := i END;
  399.                 s[i] := ch; INC(i); Texts.Read(r, ch)
  400.             END;
  401.             IF (i = maxLineLen) & (ch # CR) & ~r.eot THEN
  402.                 IF b > 0 THEN i := b; org := org + i + 1 ELSE org := org + i END;
  403.                 Texts.OpenReader(r, t, org)
  404.             END;
  405.             s[i] := 0X;
  406.             Printer.String(left, y, s, Fonts.Default.name);
  407.             y := y - lsp;
  408.             IF y < bot THEN Printer.Page(copies); INC(pno); PrintHeader; y := top END
  409.         UNTIL r.eot;
  410.         IF y < top THEN Printer.Page(copies) END
  411.     END PrintDraft;
  412. (*---version without two-column printing
  413.     PROCEDURE PlaceBody* (bodyX, bodyY, bodyW, bodyH: INTEGER;
  414.             T: Texts.Text; VAR pos: LONGINT; pno: INTEGER; place: BOOLEAN);
  415.         VAR t: PrintLine; org: LONGINT; py: INTEGER; inPage: BOOLEAN;
  416.     BEGIN py := bodyY + bodyH; inPage := FALSE;
  417.         LOOP org := pos; Texts.OpenReader(R, T, org); Texts.Read(R, nextCh);
  418.             t.org := org; MeasureLine(T, pno, bodyW, t);
  419.             IF pbeg = org THEN
  420.                 IF inPage & (pageBreak IN P.opts) THEN EXIT    (*parc enforced early page break*)
  421.                 ELSIF py - bodyY < SHORT((3 * P.lsp + P.lead) DIV Unit) THEN    (*widow window*)
  422.                     INC(pos, t.span); EXIT
  423.                 ELSIF inPage OR (pageBreak IN P.opts) THEN DEC(py, SHORT(P.lead DIV Unit)); inPage := TRUE
  424.                 END
  425.             ELSE inPage := inPage OR (t.len > 0);
  426.                 IF inPage THEN DEC(py, t.h) END;
  427.                 IF py < bodyY THEN EXIT END;
  428.                 IF place THEN PlaceLine(T, pno, t, bodyX, bodyW + (5 * mm DIV Unit), py)
  429.                 ELSE ClaimPrinter
  430.                 END
  431.             END;
  432.             INC(pos, t.span);
  433.             IF t.eot THEN EXIT END
  434.         END
  435.     END PlaceBody;
  436. (*---*)
  437.     PROCEDURE MeasureColumns (pno, py, y0, w0: INTEGER; T: Texts.Text; VAR pos: LONGINT;
  438.             VAR t: ARRAY OF PrintLine; VAR nl, nr, bh: INTEGER; VAR eofPage: BOOLEAN);
  439.         VAR yl, yr, hl, hr, dh: INTEGER; inColumn, break: BOOLEAN;
  440.         PROCEDURE MeasureColumn (VAR inCol, break: BOOLEAN; lastCol: BOOLEAN; VAR py: INTEGER; VAR n: INTEGER);
  441.             VAR org: LONGINT; eot: BOOLEAN;
  442.         BEGIN
  443.             LOOP org := pos; Texts.OpenReader(R, T, org); Texts.Read(R, nextCh);
  444.                 t[n].org := org; MeasureLine(T, pno, w0, t[n]); eot := t[n].eot;
  445.                 IF ~(twoColumns IN P.opts) OR (n = LEN(t)) THEN EXIT END;
  446.                 IF pbeg = org THEN
  447.                     IF inCol & (pageBreak IN P.opts) THEN break := TRUE; EXIT    (*parc enforced early page break*)
  448.                     ELSIF lastCol & (py - y0 < SHORT((3 * P.lsp + P.lead) DIV Unit)) THEN    (*widow window*)
  449.                         t[n].h := SHORT(P.lead DIV Unit); INC(pos, t[n].span); eofPage := TRUE; EXIT
  450.                     ELSIF inCol OR (pageBreak IN P.opts) THEN inCol := TRUE;
  451.                         t[n].h := SHORT(P.lead DIV Unit); DEC(py, t[n].h)
  452.                     END;
  453.                     INC(pos, t[n].span); INC(n)
  454.                 ELSIF inCol OR (t[n].len > 0) THEN inCol := TRUE;
  455.                     IF py - t[n].h >= y0 THEN DEC(py, t[n].h); INC(pos, t[n].span); INC(n)
  456.                     ELSE eofPage := TRUE; EXIT
  457.                     END
  458.                 ELSE INC(pos, t[n].span)
  459.                 END;
  460.                 ClaimPrinter;
  461.                 IF eot THEN EXIT END
  462.             END
  463.         END MeasureColumn;
  464.     BEGIN inColumn := FALSE; break := FALSE; dh := 0;
  465.         yl := py; nl := 0; MeasureColumn(inColumn, break, FALSE, yl, nl); hl := py - yl;
  466.         yr := py; nr := nl;
  467.         IF ~break THEN MeasureColumn(inColumn, break, TRUE, yr, nr) END;
  468.         hr := py - yr;
  469.         LOOP    (*balance columns*)
  470.             IF nl = 0 THEN EXIT
  471.             ELSIF t[nl-1].len = 0 THEN DEC(nl); dh := t[nl].h;
  472.             ELSIF (hl - t[nl - 1].h > hr) & (yr - t[nl - 1].h >= y0) THEN DEC(nl);
  473.                 DEC(hl, t[nl].h); INC(yl, t[nl].h); INC(hr, t[nl].h + dh); DEC(yr, t[nl].h + dh); dh := 0
  474.             ELSE EXIT
  475.             END
  476.         END;
  477.         bh := Max(hl, hr)
  478.     END MeasureColumns;
  479.     PROCEDURE PlaceColumns (T: Texts.Text; VAR t: ARRAY OF PrintLine; pno, px, py, w0, nl, nr: INTEGER);
  480.         VAR i, x, y, w: INTEGER;
  481.     BEGIN i := 0;
  482.         x := px; y := py; w := w0 + (5 * mm DIV Unit);
  483.         WHILE i < nl DO DEC(y, t[i].h); PlaceLine(T, pno, t[i], x, w, y); INC(i) END;
  484.         x := px + (w0 + ColumnGap DIV Unit) DIV 2;
  485.         y := py; w := w0 DIV 2 + (5 * mm DIV Unit);
  486.         WHILE (i < nr) & ((t[i].len = 0) OR (t[i].pbeg = t[i].org)) DO INC(i) END;
  487.         WHILE i < nr DO DEC(y, t[i].h); PlaceLine(T, pno, t[i], x, w, y); INC(i) END
  488.     END PlaceColumns;
  489.     PROCEDURE PlaceBody* (bodyX, bodyY, bodyW, bodyH: INTEGER;
  490.             T: Texts.Text; VAR pos: LONGINT; pno: INTEGER; place: BOOLEAN);
  491.         VAR t: PrintLine; org: LONGINT; py, bh, nl, nr: INTEGER; inPage, eofPage: BOOLEAN;
  492.             bt: ARRAY 254 OF PrintLine;
  493.     BEGIN py := bodyY + bodyH; inPage := FALSE;
  494.         Printer.Line (-1, -1, -1, -1);        (* mah 7.6.95 dummy to ensure redirection to printer *)
  495.         LOOP org := pos; Texts.OpenReader(R, T, org); Texts.Read(R, nextCh);
  496.             t.org := org; MeasureLine(T, pno, bodyW, t);
  497.             IF pbeg = org THEN
  498.                 IF inPage & (pageBreak IN P.opts) THEN EXIT    (*parc enforced early page break*)
  499.                 ELSIF py - bodyY < SHORT((2 * P.lsp + P.lead) DIV Unit) THEN    (*widow window*)
  500.                     INC(pos, t.span); EXIT
  501.                 ELSIF inPage OR (pageBreak IN P.opts) THEN DEC(py, SHORT(P.lead DIV Unit)); inPage := TRUE
  502.                 END;
  503.                 INC(pos, t.span)
  504.             ELSIF twoColumns IN P.opts THEN eofPage := FALSE;
  505.                 MeasureColumns(pno, py, bodyY, bodyW, T, pos, bt, nl, nr, bh, eofPage);
  506.                 IF (nl = 0) OR (bh = 0) THEN EXIT END;
  507.                 IF place THEN PlaceColumns(T, bt, pno, bodyX, py, bodyW, nl, nr) END;
  508.                 DEC(py, bh); inPage := TRUE;
  509.                 IF eofPage THEN EXIT END
  510.             ELSE inPage := inPage OR (t.len > 0);
  511.                 IF inPage THEN DEC(py, t.h) END;
  512.                 IF py < bodyY THEN
  513.                     IF t.h > bodyH THEN INC(pos, t.span) END;    (*line is higher than page: skip*)
  514.                     EXIT
  515.                 END;
  516.                 IF place THEN PlaceLine(T, pno, t, bodyX, bodyW + (5 * mm DIV Unit), py)
  517.                 ELSE ClaimPrinter
  518.                 END;
  519.                 INC(pos, t.span)
  520.             END;
  521.             IF t.eot THEN EXIT END
  522.         END
  523.     END PlaceBody;
  524. (*---*)
  525. BEGIN fname := "Syntax10.Scn.Fnt"; Sys.Assign ("TextWidth", SYSTEM.ADR (TextWidth))
  526. END TextPrinter.
  527.